Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue32/extlistv/EXTLISTV.ZIP/EnhListView.pas

Pascal/Delphi Source File | 1997-10-02 | 19.9 KB | 647 lines

{ -----------------------------------------------------------------------------}
{ A list view control that provides enhanced functionality over the standard.  }
{ Copyright 1997, Brad Stowers.  All Rights Reserved.                          }
{ This component can be freely used and distributed in commercial and private  }
{ environments, provied this notice is not modified in any way.                }
{ -----------------------------------------------------------------------------}
{ Feel free to contact me if you have any questions, comments or suggestions   }
{ at [e-mail].                                                       }
{ The lateset version will always be available on the web at:                  }
{   http://www.pobox.com/~bstowers/delphi/                                     }
{ -----------------------------------------------------------------------------}
{ Date last modified:  September 12, 1997                                      }
{ -----------------------------------------------------------------------------}

{ -----------------------------------------------------------------------------}
{ TEnhListView v3.00 Beta 8                                                    }
{ -----------------------------------------------------------------------------}
{                                                                              }
{ Description:                                                                 }
{   A list view control that provides enhanced functionality beyond the        }
{   standard list view.  For example, automatic sorting of simple data types,  }
{   owner draw event for vsReport mode, and more.  This does NOT require any   }
{   special version of COMCTL32.DLL.                                           }
{                                                                              }
{ -----------------------------------------------------------------------------}
{                                                                              }
{ Revision History: (See History.txt for full list)                            }
{ 3.00:  Beta 5                                                                }
{        + Initial Public Beta.  Version is 3.00 to match sister component,    }
{          TExtListView, from which most of all of this came from.             }
{        + Removed the DefaultOwnerDrawing property and added a variable       }
{          boolean parameter to the OnDrawItem event that does the same.  This }
{          gives a bit more flexibility, as you can specify on a per item      }
{          basis which should be drawn normally, and which not.                }
{        + Made the Canvas parameter of the OnDrawItem event variable so that  }
{          elements can of it can be changed to affect the default drawing.    }
{          See the EnhDemo project for an example of how to draw an item in    }
{          bold italics in 3 lines of code!                                    }
{ Beta 6 + Added an OnAfterDefaultDraw event that fires for owner draw style   }
{          if default drawing is specified after it finishes.                  }
{ Beta 7 + Stupid oversight.  Would not compile under Delphi 2.                }
{ Beta 8 + Default drawing now occurs for owner draw style if not event        }
{          handler is given for OnDrawItem.                                    }
{------------------------------------------------------------------------------}


unit EnhListView;

interface

{$IFNDEF WIN32}
  ERROR!  This unit only available for Delphi 2.0 or higher!!!
{$ENDIF}

uses
  Windows, Messages, Classes, Controls, ComCtrls, CommCtrl, SysUtils, Graphics,
  StdCtrls, Menus;


type
  TIntArray = array[0..(MaxInt div SizeOf(Integer)-1)] of Integer;
  PIntArray = ^TIntArray;


  TAutoColumnSort = (acsNoSort,acsSort,acsSortToggle);
  TLVStyle = (lvStandard, lvOwnerDrawFixed);
  TLVDrawItemEvent = procedure(Control: TWinControl; var Canvas: TCanvas;
     Index: Integer; Rect: TRect; State: TOwnerDrawState;
     var DefaultDrawing: boolean) of object;
  TLVAfterDrawItemEvent = procedure(Control: TWinControl; var Canvas: TCanvas;
     Index: Integer; Rect: TRect; State: TOwnerDrawState) of object;
  TLVSortItemsEvent = procedure(Sender: TObject; const Item1, Item2: TListItem;
     SortColumn: integer; var CompResult: integer) of object;

  { Class for saved settings                                                             }
  TEnhLVSaveSettings = class(TPersistent)
  private
    FAutoSave: boolean;
    FRegistryKey: string;
    FSaveColumnSizes: boolean;
  public
    constructor Create; virtual;
    procedure StoreColumnSizes(ColCount: integer;
       const IntArray: array of integer);
    procedure ReadColumnSizes(ColCount: integer;
       var IntArray: array of integer);
  published
    property AutoSave: boolean read FAutoSave write FAutoSave default FALSE;
    property RegistryKey: string read FRegistryKey write FRegistryKey;
    property SaveColumnSizes: boolean
       read FSaveColumnSizes
       write FSaveColumnSizes
       default TRUE;
  end;


  { The new class }
  TCustomEnhListView = class(TCustomListView)
  private
    FCanvas: TCanvas;
    FStyle: TLVStyle;
    FAutoColumnSort: TAutoColumnSort;
    FAutoSortAscending: boolean;
    FTmpAutoSortAscending: boolean;
    FLastColumnClicked: Integer;
    FSaveSettings: TEnhLVSaveSettings;

    FOnSortBegin: TNotifyEvent;
    FOnSortFinished: TNotifyEvent;
    FOnDrawItem: TLVDrawItemEvent;
    FOnAfterDefaultDrawItem: TLVAfterDrawItemEvent;
    FOnSortItems: TLVSortItemsEvent;

    { Message handlers }
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
    procedure WMDestroy(var Message: TWMDestroy); message WM_DESTROY;
  protected
    { Overriden ancestor methods }
    procedure ColClick(Column: TListColumn); override;
    { Property methods }
    procedure SetAutoColumnSort(Value: TAutoColumnSort);
    procedure SetAutoSortAscending(Value: boolean);
    procedure SetStyle(Value: TLVStyle);

    procedure CreateParams(var Params: TCreateParams); override;
    procedure Loaded; override;

    { Should be published by descendants as needed }
    property AutoColumnSort: TAutoColumnSort
             read FAutoColumnSort
             write SetAutoColumnSort
             default acsNoSort;
    property AutoSortAscending: boolean
             read FAutoSortAscending
             write SetAutoSortAscending
             default TRUE;
    property CurrentSortAscending: boolean
             read FTmpAutoSortAscending;
    property SaveSettings: TEnhLVSaveSettings
             read FSaveSettings
             write FSaveSettings;
    property Style: TLVStyle
             read FStyle
             write SetStyle
             default lvStandard;

    { Events }
    property OnDrawItem: TLVDrawItemEvent
             read FOnDrawItem
             write FOnDrawItem;
    property OnAfterDefaultDrawItem: TLVAfterDrawItemEvent
             read FOnAfterDefaultDrawItem
             write FOnAfterDefaultDrawItem;
    property OnSortItems: TLVSortItemsEvent
             read FOnSortItems
             write FOnSortItems;
    property OnSortBegin: TNotifyEvent
             read FOnSortBegin
             write FOnSortBegin;
    property OnSortFinished: TNotifyEvent
             read FOnSortFinished
             write FOnSortFinished;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure StoreSettings; virtual;
    procedure LoadSettings; virtual;
    procedure DefaultSort(ColumnIndex:integer; Ascending:boolean); virtual;
    procedure Resort; virtual;
  end;


  TEnhListView = class(TCustomEnhListView)
  published
    property AutoColumnSort;
    property AutoSortAscending;
    property CurrentSortAscending;
    property SaveSettings;
    property Style;

    property OnDrawItem;
    property OnAfterDefaultDrawItem;
    property OnSortItems;
    property OnSortBegin;
    property OnSortFinished;

    { Publish TCustomListView inherited protected properties }
    property Align;
    property BorderStyle;
    property Color;
    property ColumnClick;
    property OnClick;
    property OnDblClick;
    property Columns;
    property Ctl3D;
    property DragMode;
    property ReadOnly default False;
    property Enabled;
    property Font;
    property HideSelection;
    property IconOptions;
    property Items;
    property AllocBy;
    property MultiSelect;
    property OnChange;
    property OnChanging;
    property OnColumnClick;
    property OnCompare;
    property OnDeletion;
    property OnEdited;
    property OnEditing;
    property OnEnter;
    property OnExit;
    property OnInsert;
    property OnDragDrop;
    property OnDragOver;
    property DragCursor;
    property OnStartDrag;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property ParentColor default False;
    property ParentFont;
    property ParentShowHint;
    property ShowHint;
    property PopupMenu;
    property ShowColumnHeaders;
    property SortType;
    property TabOrder;
    property TabStop default True;
    property ViewStyle;
    property Visible;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property LargeImages;
    property SmallImages;
    property StateImages;
  end;

var
  { Default drawing variables }
  DefDraw_TextOffset: integer; // Offset for the text -- 5
  DefDraw_ImageOffset: integer; // Offset for image -- 2
  DefDraw_TextOffsetWithImage: integer; // Offset for text with image -- 20


implementation

uses
  Registry;


var
  FDirection,
  FSortColNum: integer;

function __CustomSortProc1__(Item1, Item2: TListItem; Data: integer): integer; stdcall;

  function IsValidNumber(const S: string; var V: extended): boolean;
  var
    NumCode: integer;
  begin
    Val(S, V, NumCode);
    Result := (NumCode = 0);
  end;

  function IsValidDate(const S: string; var D: TDateTime): boolean;
  begin
    if Pos (DateSeparator, S) = 0 then
      Result := False
    else                        // will fail if using a long date format
      try                        // e.g., '1 January 1994'
        D := StrToDate(S);
        Result := TRUE;
      except
        D := 0;
        Result := FALSE;
      end
  end;

var
  Str1, Str2: string;
  Val1, Val2: extended;
  Date1, Date2: TDateTime;
begin
  try
    if FSortColNum = -1 then begin
      Str1 := Item1.Caption;
      Str2 := Item2.Caption;
    end else begin
      Str1 := Item1.SubItems[FSortColNum];
      Str2 := Item2.SubItems[FSortColNum];
    end;

    if IsValidDate(Str1, Date1) and IsValidDate(Str2, Date2) then
      Result := Trunc(Date1 - Date2)
    else if IsValidNumber(Str1, Val1) and IsValidNumber(Str2, Val2) then
      if   Val1 < Val2 then Result := -1
      else if Val1 > Val2 then Result := 1
      else Result := 0
    else // date check?
      Result := AnsiCompareStr(Str1, Str2);


    Result := FDirection * Result; // Set direction flag.
  except
    Result := 0;  // Something went bad in the comparison.  Say they are equal.
  end;
end;

function __CustomSortProc2__(Item1, Item2: TListItem; Data: integer): integer; stdcall;
var
  EvRes: integer;
begin
  EvRes := 0;
  TCustomEnhListView(Data).FOnSortItems(TObject(Data), Item1, Item2,
     FSortColNum, EvRes);
  Result := EvRes * FDirection;
end;

constructor TEnhLVSaveSettings.Create;
begin
  FAutoSave := FALSE;
  FRegistryKey := '';
  FSaveColumnSizes := TRUE;
end;

procedure TEnhLVSaveSettings.StoreColumnSizes(ColCount: integer;
   const IntArray: array of integer);
var
  Reg: TRegIniFile;
  x: integer;
  s: string;
begin
  if ColCount < 1 then exit;
  s := '';
  for x := 0 to ColCount-1 do
    s := s + IntToStr(IntArray[x]) + ',';
  SetLength(s, Length(s)-1);
  Reg := TRegIniFile.Create(FRegistryKey);
  try
    Reg.WriteString('Columns', 'Sizes', s);
  finally
    Reg.Free;
  end;
end;

procedure TEnhLVSaveSettings.ReadColumnSizes(ColCount: integer;
   var IntArray: array of integer);
var
  Reg: TRegIniFile;
  x,y: integer;
  s: string;
begin
  if ColCount < 1 then exit;
  s := '';
  Reg := TRegIniFile.Create(FRegistryKey);
  try
    s := Reg.ReadString('Columns', 'Sizes', '');
  finally
    Reg.Free;
  end;
  if s = '' then begin
    IntArray[0] := -1;
    exit;
  end;
  y := 0;
  for x := 0 to ColCount-1 do begin
    try
      y := Pos(',', s);
      if y = 0 then
        y := Length(s)+1;
      IntArray[x] := StrToInt(Copy(s, 1, y-1));
    except
      IntArray[x] := 0;
    end;
    s := copy(s, y+1, length(s));
    if s = '' then break;
  end;
end;

{ Override constructor to "zero out" our internal variable.                              }
constructor TCustomEnhListView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FSaveSettings := TEnhLVSaveSettings.Create;
  FAutoColumnSort := acsNoSort;
  FAutoSortAscending := TRUE;
  FTmpAutoSortAscending := FAutoSortAscending;
  FLastColumnClicked := -1;
  FCanvas := NIL;
  FStyle  := lvStandard;
end;

destructor TCustomEnhListView.Destroy;
begin
  FCanvas.Free;
  FSaveSettings.Free;

  inherited Destroy;
end;

procedure TCustomEnhListView.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);

  if FStyle = lvOwnerDrawFixed then
  begin
    Params.Style := Params.Style or LVS_OWNERDRAWFIXED;
    if FCanvas = NIL then
      FCanvas := TCanvas.Create;
  end else begin
    FCanvas.Free;
    FCanvas := NIL;
  end;
end;

procedure TCustomEnhListView.Loaded;
begin
  inherited Loaded;

  LoadSettings;
end;

procedure TCustomEnhListView.WMDestroy(var Message: TWMDestroy);
begin
  StoreSettings;

  inherited;
end;

procedure TCustomEnhListView.StoreSettings;
var
  ColCount: integer;
  ColArray: PIntArray;
  x: integer;
begin
  if FSaveSettings.AutoSave and (not(csDesigning in ComponentState)) then begin
    ColCount := Columns.Count;
    if ColCount > 0 then begin
      GetMem(ColArray, SizeOf(Integer)*ColCount);
      try
        if FSaveSettings.SaveColumnSizes then begin
          for x := 0 to ColCount-1 do
            ColArray[x] := Columns[x].Width;
          FSaveSettings.StoreColumnSizes(ColCount, ColArray^);
        end;
      finally
        FreeMem(ColArray);
      end;
    end;
  end;
end;

procedure TCustomEnhListView.LoadSettings;
var
  ColCount: integer;
  ColArray: PIntArray;
  x: integer;
begin
  if FSaveSettings.AutoSave and (not(csDesigning in ComponentState)) then begin
    ColCount := Columns.Count;
    if ColCount > 0 then begin
      GetMem(ColArray, SizeOf(Integer)*ColCount);
      try
        if FSaveSettings.SaveColumnSizes then begin
          FSaveSettings.ReadColumnSizes(ColCount, ColArray^);
          if ColArray[0] <> -1 then
            for x := 0 to ColCount-1 do
              Columns[x].Width := ColArray[x];
        end;
      finally
        FreeMem(ColArray);
      end;
    end;
  end;
end;

procedure TCustomEnhListView.DefaultSort(ColumnIndex: integer;
   Ascending: boolean);
begin
  if assigned(FOnSortBegin) then
    FOnSortBegin(Self);
  if Ascending then
    FDirection := 1
  else
    FDirection := -1;
  FSortColNum := ColumnIndex - 1;
  if assigned(FOnSortItems) then
    CustomSort(@__CustomSortProc2__, integer(Self))
  else
    CustomSort(@__CustomSortProc1__, 0);
  if assigned(FOnSortFinished) then
    FOnSortFinished(Self);
end;

procedure TCustomEnhListView.ColClick(Column: TListColumn);
begin
  // Check if the sort order should be toggled
  if FAutoColumnSort = acsSortToggle then
    if FLastColumnClicked = Column.Index then
      FTmpAutoSortAscending := not FTmpAutoSortAscending
    else
      FTmpAutoSortAscending := FAutoSortAscending;

  inherited ColClick(Column);

  if (FAutoColumnSort <> acsNoSort) and (Column.Index < Columns.Count) then
  begin
    DefaultSort(Column.Index, FTmpAutoSortAscending);
    FLastColumnClicked := Column.Index;
  end;
end;

procedure TCustomEnhListView.SetAutoColumnSort(Value: TAutoColumnSort);
begin
  if FAutoColumnSort <> Value then
    FAutoColumnSort := Value;
end;

procedure TCustomEnhListView.SetAutoSortAscending(Value: Boolean);
begin
  if FAutoSortAscending <> Value then begin
    FAutoSortAscending := Value;
    FTmpAutoSortAscending := Value;
  end;
end;

procedure TCustomEnhListView.Resort;
begin
  if (FAutoColumnSort <> acsNoSort) and (FLastColumnClicked >= 0) and
     (FLastColumnClicked < Columns.Count) then
    DefaultSort(FLastColumnClicked, FTmpAutoSortAscending);
end;

procedure TCustomEnhListView.CNDrawItem(var Message: TWMDrawItem);
  procedure DrawItem(Index: Integer; Rect: TRect;State: TOwnerDrawState);
  const
    DRAWTEXT_FLAGS = DT_LEFT or DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER;
  var
    Count: Integer;
    SubRect: TRect;
  begin
    SubRect := Rect;
    if assigned(SmallImages) then
    begin
      if odFocused in State then
        SmallImages.DrawingStyle := dsFocus
      else if odSelected in State then
        SmallImages.DrawingStyle := dsSelected
      else
        SmallImages.DrawingStyle := dsNormal;
      SmallImages.Draw(FCanvas, Rect.Left + DefDraw_ImageOffSet, Rect.Top,
                       Items[Index].ImageIndex);
      SubRect.Right := Rect.Left + Column[0].Width;
      inc(SubRect.Left, DefDraw_TextOffsetWithImage);
      DrawText(FCanvas.Handle, PChar(Items[Index].Caption), -1, SubRect,
         DRAWTEXT_FLAGS);
    end else begin
      SubRect.Right := Rect.Left + Column[0].Width;
      inc(SubRect.Left, DefDraw_TextOffset);
      DrawText(FCanvas.Handle, PChar(Items[Index].Caption), -1, SubRect,
         DRAWTEXT_FLAGS);
    end;

    for Count := 0 to Items[Index].Subitems.Count-1 do
    begin
      SubRect.Left := SubRect.Right;
      SubRect.Right := SubRect.Left + Column[Count+1].Width;
      Inc(SubRect.Left, DefDraw_TextOffset);
      DrawText(FCanvas.Handle, PChar(Items[Index].SubItems[Count]), -1,
         SubRect, DRAWTEXT_FLAGS);
    end;
  end;
var
  State: TOwnerDrawState;
  SubRect: TRect;
  DoDefaultDrawing: boolean;
begin { CNDrawItem }
  If FCanvas = NIL then exit;

  with Message.DrawItemStruct^ do
  begin
    State := TOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
    FCanvas.Handle := hDC;
    FCanvas.Font := Font;
    FCanvas.Brush := Brush;

    DoDefaultDrawing := FALSE;
    if (not (csDesigning in ComponentState)) and assigned(FOnDrawItem) then
      FOnDrawItem(Self, FCanvas, itemID, rcItem, State, DoDefaultDrawing)
    else
      DoDefaultDrawing := not assigned(FOnDrawItem);

    if DoDefaultDrawing or (csDesigning in ComponentState) then begin
      FCanvas.FillRect(rcItem);
      if (integer(itemID) >= 0) then
      begin
        if (odSelected in State) then
        begin
          FCanvas.Brush.Color := clHighlight;
          FCanvas.Font.Color := clHighlightText;
          SubRect := rcItem;
          if assigned(SmallImages) then
            Inc(SubRect.Left, SmallImages.Width+2);
          FCanvas.FillRect(SubRect);
        end;
        DrawItem(itemID, rcItem, State);
        if (odFocused in State) then
        begin
          SubRect := rcItem;
          if assigned(SmallImages) then
            Inc(SubRect.Left, SmallImages.Width+2);
          FCanvas.DrawFocusRect(SubRect);
        end;
      end else
        FCanvas.FillRect(rcItem);
      if (not (csDesigning in ComponentState)) and assigned(FOnAfterDefaultDrawItem) then
        FOnAfterDefaultDrawItem(Self, FCanvas, itemID, rcItem, State);

    end;
    FCanvas.Handle := 0;
  end;
end;

procedure TCustomEnhListView.SetStyle(Value: TLVStyle);
begin
  if FStyle <> Value then
  begin
    FStyle := Value;
    RecreateWnd;
  end;
end;



initialization
  DefDraw_TextOffset := 5;
  DefDraw_ImageOffset := 2;
  DefDraw_TextOffsetWithImage := 20;
end.